home *** CD-ROM | disk | FTP | other *** search
- {
- SBDSP
- Version 1.03 (9/23/94)
- Written by Ethan Brodsky
- Copyright 1994 by Ethan Brodsky. All rights reserved.
-
- This library is distributed AS IS. The author specifically disclaims
- any responsibility for any loss of profit or any consequential,
- incidental, or other damages. SBDSP is freeware and is distributed
- with full Turbo Pascal source code. You are free to incorporate parts
- of the code into your own programs as long as you give credit to Ethan
- Brodsky. This source code may only be distributed in it's original
- form, including this documentation file.
-
- ------------------------------------------------------------------------
-
- You may have used my SBVox and SBVoice units. They played VOC files
- on a Sound Blaster using Creative Labs' CT-VOICE driver. Since they
- used the CT-VOICE driver, they wouldn't work on other sound cards. The
- driver needed to be included with the program, either in a separate file
- or linked into the executable.
-
- SBDSP performs the same functions as the SBVox unit without using
- the CT-VOICE driver. It has only been tested on a SB16 and PAS16, but
- it should work on all Sound Blaster compatible sound cards. By using
- DMA transfers, it plays sound without using the CPU, saving processor
- cycles for your program.
-
- I have many improvements planned, including 16-bit sound, stereo
- effects, and mixing, along with new library for FM music. But I NEED
- FEEDBACK! If you use my code, tell me about it! If you make any
- modifications, send them to me! If you have any suggestions for
- improvements, tell me about them! If you want me to write a C version,
- or a version to play WAV files, tell me!
-
- You don't need to pay me for using this unit. All you have to do
- is put my name in the credits for your product. I'd appreciate it if
- you'd send me a message telling me how you used SBDSP. (If you used
- it in a game, tell me where I can get it) And finally, if you ever
- have a sound programming job, think of me.
-
- You can find out most of the things you need to know in order to
- use this library by looking at the PlayVOC example program, but I'll
- go over it again. The first thing you need to do is to reset the DSP,
- initialize SBDSP's internal variables, and install the interrupt
- handler. In order to do this, you need to know the sound cards base
- address, IRQ number, and 8-bit DMA channel. If this is being used
- on a Sound Blaster, this information can be obtained from the BLASTER
- environment variable. I don't know whether other cards use this. You
- can use the EnvironmentSet function to find out if the environment
- variable is set. If it is, you can call the function InitSBFromEnv.
- Otherwise, you'll have to find out the settings some other way and pass
- them to the InitSB function.
-
- Use the LoadVOCFile function to allocate a sound buffer. Make sure
- that you save the value returned from this function. It is the size of
- the allocated buffer. It will be needed when you deallocate the buffer.
- The memory needed for Sound will be allocated inside this function. You
- do NOT need to allocate it beforehand.
-
- Before you can play any sounds, you have to turn on the speaker
- output. Do this by calling TurnSpeakerOn. Make sure you turn it off
- at the end of the program. If you want to install a marker handler,
- make sure you do it now by calling SetMarkerProc. A marker handler
- will be called each time a marker block is reached. Before you install
- your marker handler, save the old one using GetMarkerProc. If the value
- returned is not nil, then another marker procedure has been installed.
- Call it each time your marker procedure is called. This is a good
- practice to get into when setting up a handler such as this. It will
- make it possible to install more than one marker procedure.
-
- To play a sound, pass a pointer to the sound buffer to PlaySound.
- Any sound output in progress will be stopped. To find out if the sound
- is finished, check the SoundPlaying variable. The VOC file format has
- a provision for repeating sounds. The sound can be set to repeat for
- a number of times (Or forever) You can break out of the loop by calling
- BreakLoop. The current iteration will finish and it will continue to
- the next block. When the program is completely finished playing sound,
- call the ShutDownSB procedure. This will stop any sound output in
- progress and remove the interrupt handler. You should deallocate all
- sound buffers by using FreeBuffer. The pointer to the buffer should be
- typecasted as a pointer. Make sure that you pass the buffer size that
- was returned by LoadVOCFile so that the right amount of memory is
- deallocated.
-
- This library will not allow you to play 16 bit or stereo VOC files.
- It will not work in protected mode since it uses DMA transfers. If you
- have any other questions, feel free to ask. If you would like me to
- make any modifications or a customized version of this unit to use in
- your program, contact me and we can work out some arrangements.
-
- There are several ways to contact me:
- E-Mail: ericbrodsky@psl.wisc.edu (Preferred)
- Phone: (608) 238-4830
- Mail:
- Ethan Brodsky
- 4010 Cherokee Dr.
- Madison, WI 53711
-
- Bug fixes and other announcements will be posted in:
- comp.lang.pascal
- comp.sys.ibm.pc.soundcard
- comp.sys.ibm.pc.soundcard.tech
- rec.games.programmer
- }
-
-
- { SBDSP is Copyright 1994 by Ethan Brodsky. All rights reserved. }
- unit Mem;
- interface
- function GetBuffer(var Buffer: pointer; BufferLength: LongInt): boolean;
- procedure FreeBuffer(Buffer: pointer; BufferLength: LongInt);
- function GetAbsoluteAddress(p: pointer): LongInt;
- implementation
- function GetBuffer(var Buffer: pointer; BufferLength: LongInt): boolean;
- var
- Dummy: pointer;
- begin
- if MaxAvail < BufferLength
- then
- begin
- GetBuffer := false;
- Buffer := nil;
- Exit;
- end;
- GetBuffer := true;
- if BufferLength < $FFFF
- then
- GetMem(Buffer, BufferLength)
- else
- begin
- GetMem(Buffer, $FFFF);
- BufferLength := BufferLength - $FFFF;
- while BufferLength > $FFFF do
- begin
- GetMem(Dummy, $FFFF);
- BufferLength := BufferLength - $FFFF;
- end;
- GetMem(Dummy, BufferLength);
- end;
- end;
- procedure FreeBuffer(Buffer: pointer; BufferLength: LongInt);
- var
- Dummy: pointer;
- LeftToFree: LongInt;
- begin
- if BufferLength < $FFFF
- then
- FreeMem(Buffer, BufferLength)
- else
- begin
- Dummy := Buffer;
- LeftToFree := BufferLength;
- FreeMem(Buffer, $FFFF);
- LeftToFree := LeftToFree - $FFFF;
- Dummy := Ptr(Seg(Dummy^) + $1000, Ofs(Dummy^));
- while LeftToFree > $FFFF do
- begin
- FreeMem(Dummy, $FFFF);
- LeftToFree := LeftToFree - $FFFF;
- Dummy := Ptr(Seg(Dummy^) + $1000, Ofs(Dummy^));
- end;
- FreeMem(Dummy, LeftToFree);
- end;
- end;
- function GetAbsoluteAddress(p: pointer): LongInt;
- begin
- GetAbsoluteAddress := LongInt(Seg(p^))*16 + LongInt(Ofs(p^));
- end;
- end.
-
-
-
-
- { SBDSP is Copyright 1994 by Ethan Brodsky. All rights reserved. }
- unit VOC;
- interface
- const
- EndBlockNum = 0;
- VoiceBlockNum = 1;
- VoiceContinueBlockNum = 2;
- SilenceBlockNum = 3;
- MarkerBlockNum = 4;
- MessageBlockNum = 5;
- RepeatBlockNum = 6;
- RepeatEndBlockNum = 7;
- ExtendedInfoBlockNum = 8;
- NewVoiceBlockNum = 9;
- BlockNames : array[0..9] of string =
- (
- 'Terminator',
- 'Voice Data',
- 'Voice Continuation',
- 'Silence',
- 'Marker',
- 'Message',
- 'Repeat Loop',
- 'End Repeat Loop',
- 'Extended Info',
- 'New Voice Data'
- );
- {Used in block type 1 and 8}
- Unpacked8 = 0; {8 bit (Uncompressed)}
- Packed4 = 1; {4 bit}
- Packed26 = 2; {2.6 bit}
- Packed2 = 3; {2 bit}
- PackingNames : array[0..10] of string =
- (
- '8 bit unpacked',
- '4 bit packed',
- '2.6 bit packed',
- '2 bit packed',
- '1 channel multi',
- '2 channel multi',
- '3 channel multi',
- '4 channel multi',
- '5 channel multi',
- '6 channel multi',
- '7 channel multi'
- );
- {Used in block type 9}
- Uncompressed8 = $0000;
- Compressed4 = $0001;
- Compressed26 = $0002;
- Compressed2 = $0003;
- Uncompressed16 = $0004;
- CompressedALAW = $0006;
- CompressedMULAW = $0007;
- CompressedADPCM = $0200; {Why couldn't they make this $0008?}
- CompressionNames : array[0..7] of string =
- (
- '8 bit uncompressed',
- '4 bit compressed',
- '2.6 bit compressed',
- '2 bit compressed',
- '16 bit uncompressed',
- '',
- 'ALAW compressed',
- 'MULAW compressed'
- );
- ExtendedMono = 0;
- ExtendedStereo = 1;
- ExtendedModeNames : array[0..1] of string = ('Mono', 'Stereo');
-
- NewMono = 1; {This is Creative Labs' fault}
- NewStereo = 2; {Blame it on Creative Labs}
- NewModeNames : array[1..2] of string = ('Mono', 'Stereo');
- type
- PSound = ^TSound;
- TSound = array[0..65520] of byte;
-
- PVOCHeader = ^TVOCHeader;
- TVOCHeader = array[1..26] of byte;
-
- TripleByte = array[1..3] of byte;
-
- PBlock = ^TBlock;
- TBlock =
- record
- BlockType: byte;
- BlockLength: TripleByte;
- end;
-
- PEndBlock = ^TEndBlock;
- TEndBlock =
- record
- BlockType : byte;
- end;
-
- PVoiceBlock = ^TVoiceBlock;
- TVoiceBlock =
- record
- BlockType : byte;
- BlockLength : TripleByte;
- SR : byte;
- Packing : byte;
- Data : array[0..65520] of byte;
- end;
-
- PVoiceContinueBlock = ^TVoiceContinueBlock;
- TVoiceContinueBlock =
- record
- BlockType : byte;
- BlockLength : TripleByte;
- Data : array[0..65520] of byte;
- end;
-
- PSilenceBlock = ^TSilenceBlock;
- TSilenceBlock =
- record
- BlockType : byte;
- BlockLength : TripleByte;
- Duration : word;
- SR : byte;
- end;
-
- PMarkerBlock = ^TMarkerBlock;
- TMarkerBlock =
- record
- BlockType : byte;
- BlockLength : TripleByte;
- Marker : word;
- end;
-
- PMessageBlock = ^TMessageBlock;
- TMessageBlock =
- record
- BlockType : byte;
- BlockLength : TripleByte;
- Data: array[0..65520] of char;
- end;
-
- PRepeatBlock = ^TRepeatBlock;
- TRepeatBlock =
- record
- BlockType : byte;
- BlockLength : TripleByte;
- Count: word;
- end;
-
- PRepeatEndBlock = ^TRepeatEndBlock;
- TRepeatEndBlock =
- record
- BlockType : byte;
- BlockLength : TripleByte;
- end;
- PExtendedInfoBlock = ^TExtendedInfoBlock;
- TExtendedInfoBlock =
- record
- BlockType : byte;
- BlockLength : TripleByte;
- ExtendedSR : word;
- Packing : byte;
- Mode : byte; {0 = mono, 1 = stereo}
- end;
- PNewVoiceBlock = ^TNewVoiceBlock;
- TNewVoiceBlock =
- record
- BlockType : byte;
- BlockLength : TripleByte;
- SamplingRate : word; {HZ}
- Dummy1 : array[1..2] of byte;
- BitsPerSample : byte; {Uncompressed bits per sample}
- Mode : byte; {1 = mono, 2 = stereo}
- Compression: word;
- Dummy2 : array[1..4] of byte;
- Data : array[0..64000] of byte;
- end;
- function TripleByteToLongint(TB: TripleByte): LongInt;
- function GetSamplingRate(SR: byte): LongInt;
- function GetSRByte(SamplingRate: word): byte;
- function GetExtendedSamplingRate(ExtendedSR: word; Mode: byte): LongInt;
- function BlockSize(Block: PBlock): LongInt;
- procedure IncrementPtr(var P: pointer; Count: word);
- function FindNextBlock(Block: PBlock): PBlock;
- function LoadVOCFile(FileName: string; var Sound: PSound): LongInt;
- implementation
- uses
- Mem;
- function TripleByteToLongint(TB: TripleByte): LongInt;
- begin
- TripleByteToLongint := LongInt(TB[1]) + LongInt(TB[2]) SHL 8 + LongInt(TB[3]) SHL 16;
- end;
- function GetSamplingRate(SR: byte): LongInt;
- begin
- GetSamplingRate := -1000000 div (SR - 256);
- end;
- function GetSRByte(SamplingRate: word): byte;
- begin
- GetSRByte := 256-(1000000 div SamplingRate);
- end;
- function GetExtendedSamplingRate(ExtendedSR: word; Mode: byte): LongInt;
- begin
- case Mode
- of
- ExtendedMono:
- GetExtendedSamplingRate := -256000000 div (ExtendedSR-65536);
- ExtendedStereo:
- GetExtendedSamplingRate := (-256000000 div (ExtendedSR-65536)) div 2;
- end;
- end;
- function BlockSize(Block: PBlock): LongInt;
- begin
- BlockSize := TripleByteToLongInt(Block^.BlockLength) + 4;
- end;
- procedure IncrementPtr(var P: pointer; Count: word);
- {Easier to implement in assembly}
- begin
- asm
- LES DI, P
- MOV BX, Count
- MOV AX, ES:[DI]
- MOV DX, ES:[DI+2]
- ADD AX, BX
- CMP AX, $000F
- JNA @1
- MOV BX, AX
- AND AX, $F
- AND BX, $FFF0
- MOV CL, 4
- SHR BX, CL
- ADD DX, BX
- @1:
- MOV ES:[DI], AX
- MOV ES:[DI+2], DX
- end;
- end;
- function FindNextBlock(Block: PBlock): PBlock;
- var
- NewBlock: PBlock;
- BlockSize: LongInt;
- begin
- if Block^.BlockType = EndBlockNum
- then
- begin
- FindNextBlock := nil;
- Exit;
- end;
- NewBlock := Block;
- BlockSize := TripleByteToLongInt(Block^.BlockLength) + 4;
- while BlockSize > 0 do
- begin
- if BlockSize > 64000
- then
- begin
- IncrementPtr(pointer(NewBlock), 64000);
- Dec(BlockSize, 64000);
- end
- else
- begin
- IncrementPtr(pointer(NewBlock), BlockSize);
- BlockSize := 0;
- end;
- end;
- FindNextBlock := NewBlock;
- end;
- function LoadVOCFile(FileName: string; var Sound: PSound): LongInt;
- var
- f: file;
- Dummy: Pointer;
- LeftToRead: LongInt;
- Header: PVOCHeader;
- begin
- Assign(f, FileName);
- {$I-}
- Reset(f, 1);
- {$I+}
- if IOResult <> 0
- then
- begin
- LoadVOCFile := 0; {Couldn't open file}
- Exit;
- end;
- LeftToRead := FileSize(f) - SizeOf(Header^);
- LoadVOCFile := LeftToRead;
- New(Header);
- BlockRead(f, Header^, SizeOf(Header^));
-
- if GetBuffer(pointer(Sound), LeftToRead) <> true
- then
- begin
- LoadVOCfile := 0; {Failed to allocate memory}
- Exit;
- end;
- Dummy := Sound;
- while LeftToRead > 0 do
- begin
- if LeftToRead < 64000
- then
- begin
- BlockRead(f, Dummy^, LeftToRead);
- LeftToRead := 0;
- end
- else
- begin
- BlockRead(f, Dummy^, 64000);
- LeftToRead := LeftToRead - 64000;
- IncrementPtr(Dummy, 64000);
- end;
- end;
- Close(f);
- Dispose(Header);
- end;
- begin
- end.
-
-
-
- { SBDSP is Copyright 1994 by Ethan Brodsky. All rights reserved. }
-
- {$X+} {Extended syntax on}
- unit SBDSP;
- interface
- uses
- VOC;
- const
- On = true;
- Off = false;
- type
- Proc = procedure;
- function InitSB(IRQ: byte; BaseIO: word; DMAChannel: byte): boolean;
- {This function must be called before any sound is played. It will }
- {initialize internal variables, reset the DSP chip, and install the}
- {interrupt handler. }
- {IRQ: The sound card's IRQ setting (Usually 5 or 7) }
- {BaseIO: The sound card's base IO address (Usually $220) }
- {DMAChannel: The sound card's 8-bit DMA channel (Usually 1) }
- {Returns: }
- { TRUE: Sound card initialized correctly }
- { FALSE: Error initializing sound card }
- function EnvironmentSet: boolean;
- {Returns: }
- { TRUE: The BLASTER environment variable is set }
- { FALSE: The BLASTER environment variable isn't set }
- function InitSBFromEnv: boolean;
- {This function initializes the sound card from the settings stored }
- {in the BLASTER environment variable. I'm not sure if all sound }
- {cards use the enviroment variable. }
- {Returns: }
- { TRUE: Environment variable found and sound card initialized }
- { FALSE: Environment variable not set or error initializing card}
- procedure ShutDownSB;
- {This procedure must be called at the end of the program. It stops}
- {sound output, removes the interrupt handler, and restores the old }
- {interrupt handler. }
- procedure InstallHandler;
- {This procedure will reinstall the }
- procedure UninstallHandler;
- {This procedure will remove the interrupt handler. You should not }
- {need to call this. If you do, sound output won't work until the }
- {handler is reinstalled. }
- function ResetDSP: boolean;
- {This function resets the sound card's DSP chip. }
- {Returns: }
- { TRUE: The sound card's DSP chip was successfully reseted }
- { FALSE: The chip couldn't be initialized (Don't use it) }
- function GetDSPVersion: string;
- {This function returns a string containing the DSP chip version. }
- procedure TurnSpeakerOn;
- {This procedure turns on the speaker. This should be called before}
- {a sound is played, but after the sound card is initialized. }
- procedure TurnSpeakerOff;
- {Turn off the speaker so that sound can't be heard. You should do }
- {this when your program is finished playing sound. }
- function GetSpeakerState: boolean;
- {Returns the state of the speaker. Only works on SBPro and higher.}
- {Returns: }
- { TRUE: Speaker is on }
- { FALSE: Speaker is off }
- procedure PlaySound(Sound: PSound);
- {Stops any sound in progress and start playing the sound specified.}
- {Sound: Pointer to buffer that the VOC file was loaded into }
- procedure PauseSound;
- {Pauses the sound output in progress. }
- procedure ContinueSound;
- {Continues sound output stopped by Pause. }
- procedure BreakLoop;
- {Stops the loop at the end of the current iteration and continues }
- {with the next block. }
- procedure SetMarkerProc(MarkerProcedure: pointer);
- {Installs a marker handler. Each time a marker block is reached, }
- {the procedure specified is called. Before installing a handler, }
- {you should store the old handler. Your handler should also call }
- {the old handler. Look in the example program to see how this is }
- {done. }
- {MarkerProcedure: Pointer to the marker procedure }
- procedure GetMarkerProc(var MarkerProcedure: pointer);
- {Gets the current marker procedure. }
- {MarkerProcedure: Current marker procedure (nil if none) }
- var
- SoundPlaying : boolean;
- Looping : boolean;
- UnknownBlock : boolean;
- UnplayedBlock : boolean;
- LastMarker : word;
- implementation
- uses
- DOS,
- CRT,
- Mem;
- const
- {DSP Commands}
- CmdDirectDAC = $10;
- CmdNormalDMADAC = $14;
- Cmd2BitDMADAC = $16;
- Cmd2BitRefDMADAC = $17;
- CmdDirectADC = $20;
- CmdNormalDMAADC = $24;
- CmdSetTimeConst = $40;
- CmdSetBlockSize = $48;
- Cmd4BitDMADAC = $74;
- Cmd4BitRefDMADAC = $75;
- Cmd26BitDMADAC = $76;
- Cmd26BitRefDMADAC = $77;
- CmdSilenceBlock = $80;
- CmdHighSpeedDMADAC = $91;
- CmdHighSpeedDMAADC = $99;
- CmdHaltDMA = $D0;
- CmdSpeakerOn = $D1;
- CmdSpeakerOff = $D3;
- CmdGetSpeakerState = $D8;
- CmdContinueDMA = $D4;
- CmdGetVersion = $E1;
- DACCommands : array[0..3] of byte = (CmdNormalDMADAC, Cmd4BitDMADAC, Cmd26BitDMADAC, Cmd2BitDMADAC);
- var
- ResetPort : word;
- ReadPort : word;
- WritePort : word;
- PollPort : word;
-
- PICPort : byte;
- IRQStartMask : byte;
- IRQStopMask : byte;
- IRQIntVector : byte;
- IRQHandlerInstalled : boolean;
-
- DMAStartMask : byte;
- DMAStopMask : byte;
- DMAModeReg : byte;
-
- OldIntVector : pointer;
- OldExitProc : pointer;
-
- MarkerProc : pointer;
- var
- VoiceStart : LongInt;
- CurPos : LongInt;
- CurPageEnd : LongInt;
- VoiceEnd : LongInt;
- LeftToPlay : LongInt;
- TimeConstant : byte;
- SoundPacking : byte;
- CurDACCommand : byte;
-
- LoopStart : PBlock;
- LoopsRemaining : word;
- EndlessLoop : boolean;
-
- SilenceBlock : boolean;
-
- CurBlock : PBlock;
- NextBlock : PBlock;
-
- procedure EnableInterrupts; InLine($FB); {STI}
- procedure DisableInterrupts; InLine($FA); {CLI}
- procedure WriteDSP(Value: byte);
- Inline
- (
- $8B/$16/>WritePort/ {MOV DX, WritePort (Variable) }
- $EC/ {IN AL, DX }
- $24/$80/ {AND AL, 80h }
- $75/$FB/ {JNZ -05 }
- $58/ {POP AX }
- $8B/$16/>WritePort/ {MOV DX, WritePort (Variable) }
- $EE {OUT DX, AL }
- );
- function ReadDSP: byte;
- Inline
- (
- $8B/$16/>PollPort/ {MOV AL, PollPort (Variable) }
- $EC/ {IN AL, DX }
- $24/$80/ {AND AL, 80h }
- $74/$FB/ {JZ -05 }
- $8B/$16/>ReadPort/ {MOV DX, ReadPort (Variable) }
- $EC {IN AL,DX }
- );
- function InitSB(IRQ: byte; BaseIO: word; DMAChannel: byte): boolean;
- const
- IRQIntNums : array[0..15] of byte =
- ($08, $09, $0A, $0B, $0C, $0D, $0E, $0F,
- $70, $71, $72, $73, $74, $75, $76, $77);
- var
- Success: boolean;
- begin
- if IRQ <= 7
- then PICPort := $21 {INTC1}
- else PICPort := $A1; {INTC2}
- IRQIntVector := IRQIntNums[IRQ];
- IRQStopMask := 1 SHL (IRQ mod 8);
- IRQStartMask := not(IRQStopMask);
-
- ResetPort := BaseIO + $6;
- ReadPort := BaseIO + $A;
- WritePort := BaseIO + $C;
- PollPort := BaseIO + $E;
-
- DMAStartMask := DMAChannel + $00; {000000xx}
- DMAStopMask := DMAChannel + $04; {000001xx}
- DMAModeReg := DMAChannel + $48; {010010xx}
-
- Success := ResetDSP;
- if Success then InstallHandler;
- InitSB := Success;
- end;
- function EnvironmentSet: boolean;
- begin
- EnvironmentSet := GetEnv('BLASTER') <> '';
- end;
- function GetSetting(BLASTER: string; Letter: char; Hex: boolean; var Value: word): boolean;
- var
- EnvStr: string;
- NumStr: string;
- ErrorCode: integer;
- begin
- EnvStr := BLASTER + ' ';
- Delete(EnvStr, 1, Pos(Letter, EnvStr));
- NumStr := Copy(EnvStr, 1, Pos(' ', EnvStr)-1);
- if Hex
- then Val('$' + NumStr, Value, ErrorCode)
- else Val(NumStr, Value, ErrorCode);
- if ErrorCode <> 0
- then GetSetting := false
- else GetSetting := true;
- end;
- function GetSettings(var BaseIO, IRQ, DMAChannel: word): boolean;
- var
- EnvStr: string;
- i: byte;
- begin
- EnvStr := GetEnv('BLASTER');
- for i := 1 to Length(EnvStr) do EnvStr[i] := UpCase(EnvStr[i]);
- GetSettings := true;
- if EnvStr = ''
- then
- GetSettings := false
- else
- begin
- if not(GetSetting(EnvStr, 'A', true, BaseIO))
- then GetSettings := false;
- if not(GetSetting(EnvStr, 'I', false, IRQ))
- then GetSettings := false;
- if not(GetSetting(EnvStr, 'D', false, DMAChannel))
- then GetSettings := false;
- end;
- end;
- function InitSBFromEnv: boolean;
- var
- IRQ, BaseIO, DMAChannel: word;
- begin
- if GetSettings(BaseIO, IRQ, DMAChannel)
- then InitSBFromEnv := InitSB(IRQ, BaseIO, DMAChannel)
- else InitSBFromEnv := false;
- end;
- procedure ShutDownSB;
- begin
- ResetDSP;
- UninstallHandler;
- end;
- function ResetDSP: boolean;
- var
- i: byte;
- begin
- Port[ResetPort] := 1;
- Delay(1);
- Port[ResetPort] := 0;
- i := 1;
- while (ReadDSP <> $AA) and (i < 100) do
- Inc(i);
- if i < 100
- then ResetDSP := true
- else ResetDSP := false;
- end;
- function GetDSPVersion: string;
- var
- MajorByte, MinorByte: byte;
- MajorStr, MinorStr: string;
- begin
- WriteDSP(CmdGetVersion);
- MajorByte := ReadDSP; Str(MajorByte, MajorStr);
- MinorByte := ReadDSP; Str(MinorByte, MinorStr);
- GetDSPVersion := MajorStr + '.' + MinorStr;
- end;
- procedure TurnSpeakerOn;
- begin
- WriteDSP(CmdSpeakerOn);
- end;
- procedure TurnSpeakerOff;
- begin
- WriteDSP(CmdSpeakerOff);
- end;
- function GetSpeakerState: boolean;
- var
- SpeakerByte: byte;
- begin
- WriteDSP(CmdGetSpeakerState);
- SpeakerByte := ReadDSP;
- if SpeakerByte = 0
- then GetSpeakerState := Off
- else GetSpeakerState := On;
- end;
- procedure StartDMADSP;
- var
- Page: byte;
- Offset: word;
- Length: word;
- NextPageStart: LongInt;
- begin
- Page := CurPos shr 16;
- Offset := CurPos mod 65536;
- if VoiceEnd < CurPageEnd
- then Length := LeftToPlay-1
- else Length := CurPageEnd - CurPos;
-
- Inc(CurPos, LongInt(Length)+1);
- Dec(LeftToPlay, LongInt(Length)+1);
- Inc(CurPageEnd, 65536);
-
- WriteDSP(CmdSetTimeConst);
- WriteDSP(TimeConstant);
- Port[$0A] := DMAStopMask;
- Port[$0C] := $00;
- Port[$0B] := DMAModeReg;
- Port[$02] := Lo(Offset);
- Port[$02] := Hi(Offset);
- Port[$03] := Lo(Length);
- Port[$03] := Hi(Length);
- Port[$83] := Page;
- Port[$0A] := DMAStartMask;
- WriteDSP(CurDACCommand);
- WriteDSP(Lo(Length));
- WriteDSP(Hi(Length));
- end;
- procedure CallMarkerProc;
- begin
- if MarkerProc <> nil then Proc(MarkerProc);
- end;
- function HandleBlock(Block: PBlock): boolean;
- begin
- HandleBlock := false;
- case Block^.BlockType
- of
- EndBlockNum:
- begin
- SoundPlaying := false;
- HandleBlock := true;
- end;
- VoiceBlockNum:
- begin
- VoiceStart := GetAbsoluteAddress(Block) + 6;
- CurPageEnd := ((VoiceStart shr 16) shl 16) + 65536 - 1;
- LeftToPlay := BlockSize(Block) - 6;
- VoiceEnd := VoiceStart + LeftToPlay;
- CurPos := VoiceStart;
- TimeConstant := PVoiceBlock(Block)^.SR;
- SoundPacking := PVoiceBlock(Block)^.Packing;
- CurDACCommand := DACCommands[SoundPacking];
- StartDMADSP;
- HandleBlock := true;
- end;
- VoiceContinueBlockNum:
- begin
- VoiceStart := GetAbsoluteAddress(Block)+4;
- LeftToPlay := BlockSize(Block) - 4;
- VoiceEnd := VoiceStart + LeftToPlay;
- CurPos := VoiceStart;
- StartDMADSP;
- HandleBlock := true;
- end;
- SilenceBlockNum:
- begin
- SilenceBlock := true;
- WriteDSP(CmdSetTimeConst);
- WriteDSP(PSilenceBlock(Block)^.SR);
- WriteDSP(CmdSilenceBlock);
- WriteDSP(Lo(PSilenceBlock(Block)^.Duration+1));
- WriteDSP(Hi(PSilenceBlock(Block)^.Duration+1));
- HandleBlock := true;
- end;
- MarkerBlockNum:
- begin
- LastMarker := PMarkerBlock(Block)^.Marker;
- CallMarkerProc;
- end;
- MessageBlockNum:
- begin
- end;
- RepeatBlockNum:
- begin
- LoopStart := NextBlock;
- LoopsRemaining := PRepeatBlock(Block)^.Count+1;
- if LoopsRemaining = 0 {Wrapped around from $FFFF}
- then EndlessLoop := true
- else EndlessLoop := false;
- Looping := true;
- end;
- RepeatEndBlockNum:
- begin
- if not(EndlessLoop)
- then
- begin
- Dec(LoopsRemaining);
- if LoopsRemaining = 0
- then
- begin
- Looping := false;
- Exit;
- end;
- end;
- NextBlock := LoopStart;
- end;
- NewVoiceBlockNum:
- begin
- if (PNewVoiceBlock(Block)^.Mode = NewStereo) or (PNewVoiceBlock(Block)^.BitsPerSample = 16)
- then
- UnplayedBlock := true
- else
- begin
- VoiceStart := GetAbsoluteAddress(Block) + 16;
- CurPageEnd := ((VoiceStart shr 16) shl 16) + 65536 - 1;
- LeftToPlay := BlockSize(Block) - 16;
- VoiceEnd := VoiceStart + LeftToPlay;
- CurPos := VoiceStart;
- TimeConstant := GetSRByte(PNewVoiceBlock(Block)^.SamplingRate);
- SoundPacking := PNewVoiceBlock(Block)^.Compression;
- CurDACCommand := DACCommands[SoundPacking];
- StartDMADSP;
- HandleBlock := true;
- end;
- end;
- else
- UnknownBlock := true;
- end;
- end;
- procedure ProcessBlocks;
- begin
- repeat
- CurBlock := NextBlock;
- NextBlock := FindNextBlock(pointer(CurBlock));
- until HandleBlock(CurBlock);
- end;
- procedure ClearInterrupt;
- var
- Temp: byte;
- begin
- Temp := Port[PollPort];
- Port[$20] := $20;
- end;
- procedure IntHandler; interrupt;
- begin
- if SilenceBlock {Interrupted because a silence block ended}
- then
- begin
- SilenceBlock := false;
- ProcessBlocks;
- end
- else {Interrupted because a DMA transfer was completed}
- if LeftToPlay <> 0
- then StartDMADSP
- else ProcessBlocks;
-
- ClearInterrupt;
- end;
- procedure PlaySound(Sound: PSound);
- begin
- PauseSound;
- NextBlock := PBlock(Sound);
- SoundPlaying := true;
- Looping := false;
- LastMarker := 0;
- UnknownBlock := false;
- UnplayedBlock := false;
-
- LoopStart := nil;
- LoopsRemaining := 0;
- EndlessLoop := false;
-
- ProcessBlocks;
- end;
- procedure PauseSound;
- begin
- WriteDSP(CmdHaltDMA);
- end;
- procedure ContinueSound;
- begin
- WriteDSP(CmdContinueDMA);
- end;
- procedure BreakLoop;
- begin
- LoopsRemaining := 1;
- EndlessLoop := false;
- end;
-
- procedure StopSBIRQ;
- begin
- Port[PICPort] := Port[PICPort] OR IRQStopMask;
- end;
- procedure StartSBIRQ;
- begin
- Port[PICPort] := Port[PICPort] AND IRQStartMask;
- end;
- procedure InstallHandler;
- begin
- DisableInterrupts;
- StopSBIRQ;
- GetIntVec(IRQIntVector, OldIntVector);
- SetIntVec(IRQIntVector, @IntHandler);
- StartSBIRQ;
- EnableInterrupts;
- IRQHandlerInstalled := true;
- end;
- procedure UninstallHandler;
- begin
- DisableInterrupts;
- StopSBIRQ;
- SetIntVec(IRQIntVector, OldIntVector);
- EnableInterrupts;
- IRQHandlerInstalled := false;
- end;
-
- procedure SetMarkerProc(MarkerProcedure: pointer);
- begin
- MarkerProc := MarkerProcedure;
- end;
- procedure GetMarkerProc(var MarkerProcedure: pointer);
- begin
- MarkerProcedure := MarkerProc;
- end;
- procedure SBDSPExitProc; far;
- begin
- ExitProc := OldExitProc;
- ResetDSP;
- if (IRQHandlerInstalled = true) then UninstallHandler;
- end;
- begin
- MarkerProc := nil;
- OldExitProc := ExitProc;
- ExitProc := @SBDSPExitProc;
- SoundPlaying := false;
- end.
-
-
- { SBDSP is Copyright 1994 by Ethan Brodsky. All rights reserved. }
- {$M 16384, 0, 419430 Give some memory to the DOS shell. If you are not}
- {going to shell to DOS, you can remove this line and let your program use}
- {all available memory for the heap.}
- program PlayVOCDirect;
- uses
- CRT,
- DOS,
- Mem,
- SBDSP,
- VOC;
- const
- IRQ = 5;
- BaseIO = $220;
- DMAChannel = 1;
- DefaultVOC = 'C:\MUSIC\ESCAPE2.VOC';
- {Put the name of the VOC file to play here}
- {or pass it as a parameter to the program.}
- var
- VOCFileName : string;
- SoundSize : LongInt;
- Sound : PSound;
- Chr : char;
- OldMarkerProc : pointer;
- function GetHexWordStr(w: word): string;
- const
- HexChars: array [0..$F] of Char = '0123456789ABCDEF';
- begin
- GetHexWordStr := HexChars[Hi(w) shr 4] + HexChars[Hi(w) and $F] +
- HexChars[Lo(w) shr 4] + HexChars[Lo(w) and $F];
- end;
- procedure DisplayMarker; far;
- var
- Hour, Minute, Second, Sec100: word;
- begin
- GetTime(Hour, Minute, Second, Sec100);
- writeln('Reached marker ', LastMarker,
- ' at ', Hour, ':', Minute, ':', Second, '.', Sec100);
- if (OldMarkerProc <> nil) then Proc(OldMarkerProc);
- {If another handler is installed, call it}
- end;
- procedure WriteInstructions;
- begin
- writeln('Begining output of sound file');
- writeln('Press <B> to break loop');
- writeln('Press <P> to pause output');
- writeln('Press <C> to continue output');
- writeln('Press <D> to shell to DOS');
- writeln('Press <X> to stop output and exit');
- end;
- begin
- writeln; writeln;
-
- if EnvironmentSet
- then
- begin
- if InitSBFromEnv
- then
- begin
- writeln('Sound card initialized correctly using the BLASTER environment variable!');
- writeln('DSP version ', GetDSPVersion);
- end
- else
- begin
- writeln('Error initializing sound card!');
- Halt(255);
- end;
- end
- else
- begin
- writeln('BLASTER environment variable not set, using default settings');
- writeln('IRQ = ', IRQ, ' Base IO = $', GetHexWordStr(BaseIO), ' DMA Channel = ', DMAChannel );
- if InitSB(IRQ, BaseIO, DMAChannel)
- then
- begin
- writeln('Sound card initialized correctly!');
- writeln('DSP version ', GetDSPVersion);
- end
- else
- begin
- writeln('Error initializing sound card!');
- Halt(255);
- end;
- end;
-
- if ParamCount = 0
- then VOCFileName := DefaultVOC
- else VOCFileName := ParamStr(1);
- SoundSize := LoadVOCfile(VOCFileName, Sound); writeln('Sound file loaded');
- if SoundSize = 0
- then
- begin
- writeln('Error loading VOC file. Probably because:');
- writeln(' 1. There is no VOC file by name ', VOCFileName, '.');
- writeln(' 2. There is not enough memory to load it.');
- writeln(' Largest available block: ', MaxAvail, ' bytes');
- Halt;
- end;
-
- GetMarkerProc(OldMarkerProc);
- SetMarkerProc(@DisplayMarker);
-
- TurnSpeakerOn;
- WriteInstructions;
- PlaySound(Sound);
- repeat
- if KeyPressed
- then
- begin
- Chr := UpCase(ReadKey);
- case Chr
- of
- 'B':
- begin
- BreakLoop;
- writeln('Broke out of loop');
- end;
-
- 'P':
- begin
- PauseSound;
- writeln('Sound output paused');
- end;
- 'C':
- begin
- ContinueSound;
- writeln('Sound output continued');
- end;
- 'D':
- begin
- SwapVectors;
- Exec(GetEnv('COMSPEC'), '');
- if DOSError <> 0
- then
- begin
- writeln('Error running COMMAND.COM!');
- Halt(255);
- end;
- SwapVectors;
- WriteInstructions;
- end;
- 'X':
- begin
- PauseSound;
- writeln('Sound output stopped!');
- Exit;
- end;
- end;
- end;
- if UnknownBlock
- then
- begin
- writeln('An unknown VOC block was reached. It is probably');
- writeln('block 8, which I didn''t implement because it is');
- writeln('useless. (At least for this library it is)');
- UnknownBlock := false;
- end;
- if UnplayedBlock
- then
- begin
- writeln('A 16-bit or stereo block was reached. This library');
- writeln('doesn''t support either of these.');
- UnplayedBlock := false;
- end;
- until (SoundPlaying = false);
- TurnSpeakerOff;
-
- SetMarkerProc(OldMarkerProc); {Not really necessary}
- FreeBuffer(pointer(Sound), SoundSize);
- ShutDownSB;
- end.